Chapter 13
Code example 13-1
Sub ListCBars()
    Dim cbar As CommandBar
    Dim cbType As String
    For Each cbar In CommandBars
        Select Case cbar.Type
            Case msoBarTypeNormal
                cbType = "Toolbar"
            Case msoBarTypeMenuBar
                cbType = "Menu Bar"
            Case msoBarTypePopup
                cbType = "Shortcut"
        End Select
        Debug.Print cbar.Index, cbar.Name, cbType, cbar.Visible
    Next
End Sub
Code example 13-2
Public Sub NewCB()
Dim repBar As CommandBar
Dim newBtn As CommandBarButton
'Add an error routine in case the command bar already exists
On Error Resume Next
CommandBars("MyReport").Delete
On Error GoTo 0

'Add the new command bar to the collection
Set repBar = CommandBars.Add("MyReport", msoBarFloating)
'Add buttons to the floating toolbar
Set newBtn = repBar.Controls _
    .Add(msoControlButton, CommandBars("Print Preview") _
    .Controls("One Page").ID)
Set newBtn = repBar.Controls _
    .Add(msoControlButton, CommandBars("Print Preview") _
    .Controls("Two Pages").ID)
Set newBtn = repBar.Controls _
    .Add(msoControlButton, CommandBars("Print Preview") _
    .Controls("Zoom").ID)
Set newBtn = repBar.Controls _
    .Add(msoControlButton, CommandBars("Database") _
    .Controls("Save").ID)
Set newBtn = repBar.Controls _
    .Add(msoControlButton, CommandBars("Database") _
    .Controls("Cut").ID)
Set newBtn = repBar.Controls _
    .Add(msoControlButton, CommandBars("Database") _
    .Controls("Copy").ID)
Set newBtn = repBar.Controls _
    .Add(msoControlButton, CommandBars("Database") _
    .Controls("Paste").ID)
repBar.Visible = True
End Sub
Code example 13-3
Public Sub StyleButtons()
'Creates a toolbar with 7 buttons each with a different button style
Dim NewBtn As CommandBarButton
Dim NewBar As CommandBar

On Error Resume Next
CommandBars("StyleBar").Delete
On Error GoTo 0

Set NewBar = CommandBars.Add("StyleBar", msoBarFloating)
Set NewBtn = CommandBars("StyleBar").Controls.Add _
    (Type:=msoControlButton)
    With NewBtn
        .Caption = "New Style"
        .FaceId = 2
        .Style = msoButtonAutomatic
    End With

Set NewBtn = CommandBars("StyleBar").Controls.Add _
    (Type:=msoControlButton)
    With NewBtn
        .Caption = "New Style"
        .FaceId = 2
        .Style = msoButtonIcon
        .BeginGroup = True
    End With
Set NewBtn = CommandBars("StyleBar").Controls.Add _
    (Type:=msoControlButton)
    With NewBtn
        .Caption = "New Style"
        .FaceId = 2
        .Style = msoButtonCaption
        .BeginGroup = True
    End With
Set NewBtn = CommandBars("StyleBar").Controls.Add _
    (Type:=msoControlButton)
    With NewBtn
        .Caption = "New Style"
        .FaceId = 2
        .Style = msoButtonIconAndCaption
        .BeginGroup = True
    End With
Set NewBtn = CommandBars("StyleBar").Controls.Add _
    (Type:=msoControlButton)
    With NewBtn
    .Caption = "New Style"
        .FaceId = 2
        .Style = msoButtonIconAndWrapCaption
        .BeginGroup = True
    End With
Set NewBtn = CommandBars("StyleBar").Controls.Add _
    (Type:=msoControlButton)
    With NewBtn
        .Caption = "New Style"
        .FaceId = 2
        .Style = msoButtonIconAndCaptionBelow
        .BeginGroup = True
    End With
Set NewBtn = CommandBars("StyleBar").Controls.Add _
    (Type:=msoControlButton)
    With NewBtn
        .Caption = "New Style"
        .FaceId = 2
        .Style = msoButtonWrapCaption
        .BeginGroup = True
    End With
Set NewBtn = CommandBars("StyleBar").Controls.Add _
    (Type:=msoControlButton)
    With NewBtn
        .Caption = "New Style"
        .FaceId = 2
        .Style = msoButtonIconAndWrapCaptionBelow
        .BeginGroup = True
    End With
End Sub
Code example 13-4
Public Sub AddCtrl()
 Dim NewCtrl As CommandBarControl
 CommandBars("MyReport").Controls(5).BeginGroup = True
 Set NewCtrl = CommandBars("MyReport").Controls.Add _
    (Type:=msoControlButton)
With NewCtrl
    .FaceId = 46    'The Find button icon.
    .BeginGroup = True
    .OnAction = "ReptMacro"
    .Caption = "Click to find region report"
End With  
End Sub
Code example 13-5
Public Sub AddCombo()
'Declare the new control as a combo box
Dim newCombo As CommandBarComboBox
Set newCombo = CommandBars("MyReport").Controls.Add _
    (Type:=msoControlComboBox)
With newCombo
'Create the value list
    .AddItem "Region 1"
    .AddItem "Region 2"
    .AddItem "Region 3"
    .AddItem "Region 4"
    .AddItem "Region 5"
    .AddItem "Marine"
    .Caption = "Region"
    .Style = msoComboLabel        'Include a control label
    .OnAction = "AddFilter"        'Executes a macro
End With
End Sub
Code example 13-6
Public Sub AddMenu()
Dim NewMenu As CommandBarPopup
Dim NewItem As CommandBarControl
Dim NewSub As CommandBarPopup
Dim NewSubItem As CommandBarButton
'Add the new menu to the built-in Menu Bar, Index 4.
Set NewMenu = CommandBars(4).Controls _
    .Add(Type:=msoControlPopup, Temporary:=True, Before:=16)
NewMenu.Caption = "Custom"

'Next add the menu itmes to the new menu.
Set newItem = NewMenu.Controls.Add _
    (Type:=msoControlButton)
    With newItem
        .Caption = "Item 1"
        .FaceId = 123
        .OnAction = "MacroA"
    End With
Set newItem = NewMenu.Controls.Add _
    (Type:=msoControlButton)
    With newItem
        .Caption = "Item 2"
        .FaceId = 234
        .OnAction = "MacroB"
    End With
Set newItem = NewMenu.Controls.Add _
    (Type:=msoControlButton)
    With newItem
        .Caption = "Item 3"
        .FaceId = 345
        .OnAction = "MacroC"
    End With
Set newItem = NewMenu.Controls.Add _
    (Type:=msoControlPopup)
    With newItem
        .Caption = "SubMenu"
        .BeginGroup = True
    End With
Set NewSubItem = newItem.Controls.Add _
    (Type:=msoControlButton)
    With NewSubItem
        .Caption = "Sub Item 1"
        .FaceId = 321
        .OnAction = "MacroD"
    End With
Set NewSubItem = newItem.Controls.Add _
    (Type:=msoControlButton)
    With NewSubItem
        .Caption = "Sub Item 2"
        .FaceId = 432
        .OnAction = "MacroE"
    End With
End Sub
Code example 13-7
Public Sub AddItem()
Dim ViewMenu As CommandBarPopup
Dim newItem As CommandBarButton
'The View menu has the ID value of 30004.
'On Error routine executes if the control already exists.
On Error Resume Next
CommandBars(4).FindControl(ID:=30004) _
    .Controls("View Cat Pictures").Delete
On Error GoTo 0

Set ViewMenu = CommandBars(4).FindControl(ID:=30004)
Set newItem = ViewMenu.Controls.Add _
    (Type:=msoControlButton, Temporary:=True)
With newItem
    .Caption = "View Cat Pictures"
    .FaceId = 165
    .OnAction = "ViewCatPictures"
    .BeginGroup = True
End With
End Sub
Code example 13-8
Public Sub NewMenuBar()
Dim mBar As CommandBar
Dim mMenu As CommandBarControl
Dim mItem As CommandBarControl
Dim NewSubItem As CommandBarControl

'Delete the New Menu Bar if it already exists.
On Error Resume Next
CommandBars("New Menu Bar").Delete
On Error GoTo 0

Set mBar = CommandBars.Add(MenuBar:=True, _
    Position:=msoBarTop, Temporary:=True)
With mBar
    .Name = "New Menu Bar"
    .Visible = True
End With

Set mMenu = mBar.Controls.Add(Type:=msoControlPopup)
mMenu.Caption = "&First Menu"

Set mMenu = mBar.Controls.Add(Type:=msoControlPopup)
mMenu.Caption = "&Second Menu"

Set mMenu = mBar.Controls.Add(Type:=msoControlPopup)
mMenu.Caption = "&Third Menu"
Set mItem = mMenu.Controls.Add(Type:=msoControlButton)
With mItem
    .Caption = "F&irst Command"
    .FaceId = 356
    .OnAction = "Run First"
End With
Set mItem = mMenu.Controls.Add(Type:=msoControlButton)
With mItem
    .Caption = "&Second Command"
    .FaceId = 333
    .OnAction = "Run Second"
End With
Set mItem = mMenu.Controls.Add(Type:=msoControlPopup)
mItem.Caption = "SubMenu"

Set NewSubItem = mItem.Controls.Add _
    (Type:=msoControlButton)
    With NewSubItem
        .Caption = "Sub Item 1"
        .FaceId = 321
        .OnAction = "MacroD"
    End With
Set NewSubItem = mItem.Controls.Add _
    (Type:=msoControlButton)
    With NewSubItem
        .Caption = "Sub Item 2"
        .FaceId = 432
        .OnAction = "MacroE"
    End With
End Sub
Code example 13-9
Public Sub SCMMenus()
Dim cBar As CommandBar
For Each cBar In CommandBars
    If cBar.Type = msoBarTypePopup Then
        Debug.Print cBar.Index, cBar.Name
    End If
Next cBar
End Sub
Code example 13-10
Public Sub CreateSCM()
Dim newSCM As CommandBar
Dim ctrl1 As CommandBarControl, ctrl2 As CommandBarControl
Dim ctrl3 As CommandBarControl, ctrl4 As CommandBarControl

'Delete the My Shortcut menu if it already exists.
On Error Resume Next
CommandBars("My Shortcut").Delete
On Error GoTo 0

Set newSCM = CommandBars.Add _
    (Name:="My Shortcut", Position:=msoBarPopup, Temporary:=True)
Set ctrl1 = newSCM.Controls.Add(Type:=msoControlButton)
With ctrl1
    .Caption = "Copy"
    .FaceId = 22
End With

Set ctrl2 = newSCM.Controls.Add(Type:=msoControlButton)
With ctrl2
    .Caption = "Check Spelling"
    .FaceId = 2
End With

Set ctrl3 = newSCM.Controls.Add(Type:=msoControlButton)
With ctrl3
    .Caption = "Print"
    .FaceId = 4
End With

Set ctrl4 = newSCM.Controls.Add(Type:=msoControlButton)
With ctrl4
    .Caption = "Find"
    .FaceId = 46
End With

newSCM.ShowPopup 200, 200
End Sub

Access Power Programming with VBA, 8/23/2003, Web code examples
Virginia Andersen


